home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / msdos / label / lb.bas < prev    next >
BASIC Source File  |  1991-10-18  |  36KB  |  1,295 lines

  1. DECLARE FUNCTION Line.Edit$ (Arg$, Length%, LastKey$, strflag%)
  2. DECLARE SUB New.Data ()
  3. DECLARE SUB PageCopy ()
  4. DECLARE SUB Save.DEF ()
  5. DECLARE SUB DATAX ()
  6. DECLARE SUB Disp.TOKEI ()
  7. DECLARE SUB UpPage (Page%, Count%)
  8. DECLARE SUB DownPage (Page%, Count%)
  9. DECLARE SUB MENU ()
  10. DECLARE SUB InsLine ()
  11. DECLARE SUB DelLine ()
  12. DECLARE SUB Gamen ()
  13. DECLARE SUB Clear.Msg ()
  14. DECLARE SUB Heiten ()
  15. DECLARE SUB Func.ON (PF.Number AS INTEGER)
  16. DECLARE SUB Set.KGM (SetNO AS INTEGER)
  17. DECLARE SUB Data.Clear ()
  18. DECLARE SUB Set.Data ()
  19. DECLARE SUB NO.Data ()
  20. DECLARE SUB Disp.Name ()
  21. DECLARE SUB Boo ()
  22. DECLARE SUB Disp.Func ()
  23. DECLARE SUB Data.Load ()
  24. DECLARE SUB Data.Save ()
  25. DECLARE SUB Data.Set ()
  26. DECLARE SUB Disp.Help ()
  27. DECLARE SUB Disp.Page (Page%)
  28. DECLARE SUB ENDING ()
  29. DECLARE SUB Write.LCR (FG AS INTEGER)
  30.  
  31. ' ┏━━━━━━┯━━━━━━━━━━━━━━━━━━━┓
  32. ' ┃プログラム名│LB.BAS (LB.EXE)                       ┃
  33. ' ┃タ イ ト ル │簡易版印刷屋さん  Ver. 3.00           ┃
  34. ' ┃プログラマー│NIF ID:MAG01022   Trouble・MakerのJ.J┃
  35. ' ┠──────┼───────────────────┨
  36. ' ┃使 用 機種│富士通     FM TOWNS モデル2H   ┃
  37. ' ┃使 用 言語│Microsoft  QuickBASIC 4.5 + MASM 5.1  ┃
  38. ' ┠──────┼───────────────────┨
  39. ' ┃制 作 日 付 │For 1991.01.03 to 1991.01.15          ┃
  40. ' ┗━━━━━━┷━━━━━━━━━━━━━━━━━━━┛
  41.  
  42. '$INCLUDE: 'JJ.BI'
  43. '----------------------- 初期設定
  44. CLEAR
  45.  
  46. DIM SHARED In$(12)                             ' 編集用文書データ
  47. DIM SHARED Saizu(12) AS INTEGER                ' サイズデータ
  48. DIM SHARED Sonota(4) AS INTEGER                ' DEFファイル
  49. DIM SHARED SONO$(4)
  50.  
  51. DIM SHARED N AS INTEGER                        ' 汎用変数
  52. DIM SHARED CY AS INTEGER                       ' カーソル Y ザヒョウ
  53. DIM SHARED Ins%                                ' インサート フラグ
  54. DIM SHARED Drive$                              ' データ ドライブ&データメイ
  55. DIM SHARED CurDir$                             ' カレントディレクトリィ
  56.  
  57. CONST maxpage% = 30                            ' 最大登録 Page 数
  58. DIM SHARED Saizu.Data(maxpage) AS STRING * 10  ' サイズ データ
  59. DIM SHARED Bun.Data(maxpage) AS STRING * 432   ' 文書 データ
  60. DIM SHARED Page.No%                            ' Page ナンバー
  61.  
  62. CONST YN.MSG$ = "○:実 行  ×:取 消"
  63. CONST ERR.MSG$ = "中止<A>, もう一度<R>, 無視<I>? "
  64.    
  65. CONST NG = 0
  66. CONST OK = -1
  67. '-----------------------------------------------------------------------
  68.         DriveNo% = GetCurDrive                         ' カレントディレクトリィ NO
  69.         CurDir$ = GetCurDir$(DriveNo%)                 ' カレントディレクトリィ
  70.         ANS% = CheckFile%(CurDir$ + "LABEL.DEF")       ' DEFファイル CHECK
  71.  
  72.         IF ANS% = 0 THEN bell 800, 32: bell 620, 40: PRINT "LABEL.DEF がありません!!": END
  73.  
  74.         OPEN CurDir$ + "LABEL.DEF" FOR RANDOM AS 2 LEN = 48
  75.         FIELD #2, 36 AS Drive.Name$, 12 AS Sonota.Data$
  76.         GET #2, 1
  77.  
  78.             Drive$ = Drive.Name$: SD$ = Sonota.Data$
  79.             P = 1
  80.             FOR I = 1 TO 4
  81.                 Sonota(I) = VAL(MID$(SD$, P, 3))
  82.                 P = P + 3
  83.             NEXT I
  84.         CLOSE #2
  85.  
  86.             Drive$ = RTRIM$(Drive$)
  87.  
  88.             ON ERROR GOTO ErrorProc       ' エラー ショリ ルーチン
  89. '==============================================================================
  90.             Gamen             ' 画面描画
  91.             CY = 5: cx = 23   ' ショキ カーソル イチ
  92. DO
  93.     DO: LOOP WHILE INKEY$ <> ""   ' キーバッフアークリアー
  94.  
  95.         LOCATE 1, 37, 0: COLOR 0, 3: PRINT USING "##"; CY - 4; : COLOR 7, 0
  96.         LOCATE CY, cx
  97.         N = CY - 4
  98.  
  99.        In$(N) = Line.Edit$(In$(N), 36, LastKey$, 0)
  100.  
  101.         Clear.Msg
  102.  
  103.         SELECT CASE LastKey$
  104.             CASE CHR$(13), CHR$(0, &H50), CHR$(&H18) ' リターンキー,DOWN,^C
  105.                 GOSUB Pos.Down
  106.             CASE CHR$(&H1B)                ' ESC
  107.                 Heiten
  108.             CASE CHR$(0, &H48), CHR$(&H5)  ' UP,^E
  109.                 GOSUB Pos.Up
  110.             CASE CHR$(0, &H47), CHR$(&HA)  ' HOME,^J
  111.                 Disp.Help
  112.             CASE CHR$(0, &H3B)             ' PF1
  113.                 Func.ON 1: Set.KGM 1
  114.             CASE CHR$(0, &H3C)             ' PF2
  115.                 Func.ON 2: Set.KGM 2
  116.             CASE CHR$(0, &H3D)             ' PF3
  117.                 Func.ON 3: Set.KGM 3
  118.             CASE CHR$(0, &H3E)             ' PF4
  119.                 Func.ON 4: Set.KGM 4
  120.             CASE CHR$(0, &H3F)             ' PF5
  121.                 Func.ON 5: Data.Clear
  122.             CASE CHR$(0, &H40)             ' PF6
  123.                 Func.ON 6: GOSUB Print.OUT
  124.             CASE CHR$(0, &H41)             ' PF7
  125.                 Func.ON 7: Write.LCR 1
  126.             CASE CHR$(0, &H42)             ' PF8
  127.                 Func.ON 8: Write.LCR 2
  128.             CASE CHR$(0, &H43)             ' PF9
  129.                 Func.ON 9: Write.LCR 3
  130.             CASE CHR$(0, &H44)             ' PF10
  131.                 Func.ON 10: MENU
  132.             CASE CHR$(0, &H85)             ' PF11
  133.                 DownPage Page.No%, 5
  134.             CASE CHR$(0, &H86)             ' PF12
  135.                 UpPage Page.No%, 5
  136.             CASE CHR$(0, &H5D)             ' SHIFT+PF10
  137.                 IF N > 1 THEN In$(N) = In$(N - 1)
  138.             CASE CHR$(0, &H51), CHR$(&H3)  ' 次行
  139.                 UpPage Page.No%, 1
  140.             CASE CHR$(0, &H49), CHR$(&H12) ' 前行
  141.                 DownPage Page.No%, 1
  142.             CASE CHR$(&H19)                ' ^Y
  143.                 DelLine
  144.             CASE CHR$(&HE)                 ' ^N
  145.                 InsLine
  146. '-----------------------------------------------------------------------------
  147. '           CASE CHR$(0, &H54)             ' SHIFT+PF1
  148. '           CASE CHR$(0, &H55)             ' SHIFT+PF2
  149. '           CASE CHR$(0, &H56)             ' SHIFT+PF3
  150. '           CASE CHR$(0, &H57)             ' SHIFT+PF4
  151. '           CASE CHR$(0, &H58)             ' SHIFT+PF5
  152. '           CASE CHR$(0, &H59)             ' SHIFT+PF6
  153. '           CASE CHR$(0, &H5A)             ' SHIFT+PF7
  154. '           CASE CHR$(0, &H5B)             ' SHIFT+PF8
  155. '           CASE CHR$(0, &H5C)             ' SHIFT+PF9
  156. '           CASE CHR$(0, &H87)             ' SHIFT+PF11  Line.Editで使用
  157. '           CASE CHR$(0, &H88)             ' SHIFT+PF12        〃
  158. '           CASE CHR$(&H18)                ' 取消  CHR$(24)  ^Xと同じ
  159.             CASE ELSE
  160.                 bell 600, 32
  161.         END SELECT
  162. LOOP
  163. END
  164. '==============================================================================
  165. Pos.Up:     IF CY = 5 THEN CY = 16: RETURN ELSE CY = CY - 1: RETURN
  166. Pos.Down:   IF CY = 16 THEN CY = 5: RETURN ELSE CY = CY + 1: RETURN
  167. '------------------------------------------------------ 印 刷
  168. Print.OUT:
  169.             FOR N = 1 TO 12
  170.                 IF In$(N) <= SPACE$(36) THEN  ELSE GOTO Print.OK
  171.             NEXT N
  172.             NO.Data
  173. RETURN
  174. Print.OK:
  175.             bell 650, 32:  bell 650, 32
  176.             box 22, 18, 59, 22, 10, 2
  177.             COLOR 14
  178.                 LOCATE 19, 31: PRINT "   印刷を行います.     "
  179.             COLOR 7
  180.                 LOCATE 21, 31: PRINT YN.MSG$
  181. Dame:
  182.         A$ = In.Key$
  183.  
  184.         SELECT CASE A$
  185.             CASE CHR$(13)
  186.                 Clear.Msg
  187.                 GOTO Lprint.OK
  188.             CASE CHR$(24), CHR$(27)
  189.                 Clear.Msg
  190.                 RETURN
  191.             CASE ELSE
  192.                 bell 600, 32
  193.                 GOTO Dame
  194.         END SELECT
  195. Lprint.OK:
  196.             LPRINT CHR$(27); "c";   ' リセット
  197.  
  198.             GOSUB Print.LP          ' カイギョウ ピッチ
  199.             GOSUB Print.LMRG        ' レフト マ-ジン
  200.  
  201.             FOR LP = 1 TO Sonota(1): LPRINT : NEXT LP    ' 紙送り
  202.  
  203.             box 22, 19, 59, 21, 6, 2
  204.             COLOR 14
  205.                 LOCATE 20, 30: PRINT " ** 印 刷 中 ** "
  206.             COLOR 7
  207.  
  208.             FOR P = 1 TO 12
  209.  
  210.                 SELECT CASE Saizu(P)
  211.                     CASE 0, 1
  212.                         GOSUB Print.KGM11
  213.                     CASE 2
  214.                         GOSUB Print.KGM12
  215.                     CASE 3
  216.                         GOSUB Print.KGM21
  217.                     CASE 4
  218.                         GOSUB Print.KGM22
  219.                 END SELECT
  220.  
  221.                 LPRINT In$(P)
  222.  
  223.             NEXT P
  224.  
  225.             IF Sonota(4) = 1 THEN LPRINT CHR$(12);       ' フォームフィード
  226.  
  227.             Clear.Msg
  228.  
  229. Print.END: ' 印刷終了
  230.  
  231. RETURN
  232. '------------------------------------------------------ 改行ピッチ
  233. Print.LP:
  234.         J = Sonota(3)
  235.         P1 = INT(J / 10)
  236.         P2 = INT(J - (P1 * 10))
  237.         LPRINT CHR$(28); "%";
  238.         LPRINT CHR$(&H20 + P1); CHR$(&H70 + P2);
  239. RETURN
  240. '------------------------------------------------------ 左マージン
  241. Print.LMRG:
  242.         J = Sonota(2)
  243.         P1 = INT(J / 1000)
  244.         P2 = INT((J - P1 * 1000) / 100)
  245.         P3 = INT((J - (P1 * 1000 + P2 * 100)) / 10)
  246.         P4 = INT(J - (P1 * 1000 + P2 * 100 + P3 * 10))
  247.  
  248.         LPRINT CHR$(27); "Q";
  249.         LPRINT CHR$(&H31); CHR$(&H38);
  250.         LPRINT ";";
  251.         LPRINT CHR$(&H30 + P1); CHR$(&H30 + P2);
  252.         LPRINT CHR$(&H30 + P3); CHR$(&H30 + P4);
  253.         LPRINT " Q";
  254. RETURN
  255. '------------------------------------------------------ 標 準
  256. Print.KGM11:
  257.         LPRINT CHR$(28); "$";           ' 漢字文字ピッチ27/180
  258.         LPRINT CHR$(&H22); CHR$(&H77);
  259.  
  260.         LPRINT CHR$(28); "'";
  261.         LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H60);
  262.         LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H70);
  263. RETURN
  264. '------------------------------------------------------ 横 倍
  265. Print.KGM12:
  266.         LPRINT CHR$(28); "$";           ' 漢字文字ピッチ24/180
  267.         LPRINT CHR$(&H22); CHR$(&H74);
  268.  
  269.         LPRINT CHR$(28); "'";
  270.         LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H60);
  271.         LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H70);
  272. RETURN
  273. '------------------------------------------------------ 縦 倍
  274. Print.KGM21:
  275. '       LPRINT CHR$(28); "."; "t";
  276.         LPRINT CHR$(28); "'";
  277.         LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H60);
  278.         LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H70);
  279. RETURN
  280. '------------------------------------------------------ 4 倍
  281. Print.KGM22:
  282.         LPRINT CHR$(28); "$";           ' 漢字文字ピッチ24/180
  283.         LPRINT CHR$(&H22); CHR$(&H74);
  284.  
  285. '       LPRINT CHR$(28); "."; "t";
  286.         LPRINT CHR$(28); "'";
  287.         LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H60);
  288.         LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H70);
  289. RETURN
  290. '=============================================================================
  291. PFDATA:
  292. DATA " 標準 "
  293. DATA " 横倍 "
  294. DATA " 縦倍 "
  295. DATA " 4倍 "
  296. DATA " 削除 "
  297. DATA " 印刷 "
  298. DATA " 左寄 "
  299. DATA " 中央 "
  300. DATA " 右寄 "
  301. DATA " MENU "
  302.  
  303. SttMsgLst:
  304. DATA "おしながき"
  305. DATA "Q Quit     :プログラム終了"
  306. DATA "S SetSystem:ちょっとだけ設定"
  307. DATA "D DataSet  :データ変更"
  308. DATA "P PageCopy :ページコピー"
  309. DATA "T TimeDisp :時計の表示"
  310.  
  311. HELPDATA:
  312. DATA "                             簡易版印刷屋さん   Ver. 3.00"
  313. DATA "┏━━━━━━┯━━━━━━━━━━━━━━┓┏━━━┯━━━━━━━━━┓"
  314. DATA "┃ ↑   CTRL+E│カーソルを1行上に移動する  ┃┃CTRL+Y│カーソル行削除    ┃"
  315. DATA "┃ ↓   CTRL+X│カーソルを1行下に移動する  ┃┃CTRL+N│カーソル行挿入    ┃"
  316. DATA "┃ ←   CTRL+S│カーソルを1文字左に移動する┃┃CTRL+K│カーソルの右側削除┃"
  317. DATA "┃ →   CTRL+D│カーソルを1文字右に移動する┃┃CTRL+U│カーソルの左側削除┃"
  318. DATA "┃前行  CTRL+R│1ページ前を表示します      ┃┗━━━┷━━━━━━━━━┛"
  319. DATA "┃次行  CTRL+C│1ページ次を表示します      ┃"
  320. DATA "┃PF11        │5ページ前を表示します      ┃┌─────────────┐"
  321. DATA "┃PF12        │5ページ次を表示します      ┃│       データ名の例       ┃"
  322. DATA "┃削除  CTRL+G│カーソル位置の1文字を削除  ┃│  A:\LABEL.DAT            ┃"
  323. DATA "┃ BS   CTRL+H│カーソルの直前の1文字を削除┃│  B:\LB\LABEL.DAT         ┃"
  324. DATA "┃挿入        │<挿入>・[上書]の切り換え    ┃│                          ┃"
  325. DATA "┃HOME  CTRL+J│ヘルプ画面表示を表示します  ┃│注意:LABEL.DEFという名前は┃"
  326. DATA "┃ESC         │簡易版印刷屋さんを閉店します┃│     使用してはいけません.┃"
  327. DATA "┠──────┼──────────────┨└━━━━━━━━━━━━━┛"
  328. DATA "┃  SHIFT+PF10│上の行複写                  ┃"
  329. DATA "┃  SHIFT+PF11│カーソルを行の左端に移動する┃┌─────────────┐"
  330. DATA "┃  SHIFT+PF12│カーソルを行の右端に移動する┃│ 何かキーを押すと戻ります ┃"
  331. DATA "┗━━━━━━┷━━━━━━━━━━━━━━┛└━━━━━━━━━━━━━┛"
  332.  
  333. '------------------------------------------------------ エラー処理
  334. ErrorProc:
  335.  
  336. SELECT CASE ERR
  337. CASE 25, 27
  338.         bell 800, 32: bell 620, 40
  339.         box 22, 18, 59, 22, 14, 2
  340.         COLOR 15
  341.             LOCATE 20, 28: PRINT " プリンターを確認して下さい."
  342.         COLOR 7
  343.         RESUME Print.END
  344. CASE 64:
  345.         bell 800, 32: bell 620, 40
  346.         box 22, 18, 59, 22, 14, 2
  347.         COLOR 7
  348.             LOCATE 19, 25: PRINT "ファイル名に誤りがあります."
  349.             LOCATE 21, 25: PRINT ERR.MSG$
  350.             GOTO Err.Input
  351. CASE 71:
  352.         bell 800, 32: bell 620, 40
  353.         box 22, 18, 59, 22, 14, 2
  354.         COLOR 7
  355.             LOCATE 19, 25: PRINT MID$(Drive$, 1, 1)
  356.             LOCATE 19, 26: PRINT " ドライブの準備ができていません."
  357.             LOCATE 21, 25: PRINT ERR.MSG$
  358.             GOTO Err.Input
  359. CASE 52, 53, 75, 76:
  360.         bell 800, 32: bell 620, 40
  361.         box 22, 18, 59, 22, 14, 2
  362.         COLOR 7
  363.             LOCATE 19, 24: PRINT "ファイルまたはパスが見つかりません."
  364.             LOCATE 21, 25: PRINT ERR.MSG$
  365.             GOTO Err.Input
  366. CASE ELSE:         
  367.         clrscr
  368.         bell 800, 32: bell 620, 40
  369.         CLS
  370.         PRINT "未処理のエラーが発生しました. ERR="; ERR
  371.         ON ERROR GOTO 0
  372. END SELECT
  373.  
  374. Err.Input:
  375.     DO
  376.         Char$ = UCASE$(INPUT$(1))
  377.         IF Char$ = "I" THEN
  378.             Clear.Msg
  379.             Drive$ = CurDir$ + "LABEL.DAT"
  380.             Disp.Name
  381.             RESUME           ' 元のステートメントに戻ります.
  382.         ELSEIF Char$ = "R" THEN
  383.             Restart = TRUE   ' プログラムの先頭に戻ります.
  384.             Clear.Msg
  385.             RESUME NEXT
  386.         ELSEIF Char$ = "A" THEN
  387.             END              ' プログラムを終了します.
  388.         END IF
  389.     LOOP
  390.  
  391. SUB Boo
  392.     bell 500, 32: bell 500, 32
  393.     box 22, 19, 59, 21, 14, 2
  394.     LOCATE 20, 31, 0: COLOR 12: PRINT "この行は、出来ません.": COLOR 7
  395. END SUB
  396.  
  397. SUB Clear.Msg
  398.         clrxy 1, 18, 60, 24
  399.         Disp.Func
  400. END SUB
  401.  
  402. '--------------
  403. '  データ削除
  404. '--------------
  405. SUB Data.Clear
  406.             FOR N = 1 TO 12
  407.                 IF In$(N) <= SPACE$(36) THEN  ELSE GOTO Del.OK
  408.             NEXT N
  409.             NO.Data
  410.             EXIT SUB
  411. Del.OK:
  412.             bell 650, 36: bell 650, 36
  413.             box 22, 18, 59, 22, 14, 2
  414.  
  415.             COLOR 14
  416.                 LOCATE 19, 27: PRINT "このPageを削除していいですか?"
  417.             COLOR 7
  418.                 LOCATE 21, 31: PRINT YN.MSG$
  419.                
  420.         DO
  421.             ANS$ = In.Key$
  422.                                               
  423.             SELECT CASE ANS$
  424.                 CASE CHR$(13)
  425.                     Clear.Msg
  426.                         FOR I = 1 TO 12
  427.                             LOCATE I + 4, 10, 0: PRINT "○      "
  428.                             LOCATE I + 4, 23: PRINT SPACE$(36);
  429.                             In$(I) = SPACE$(36)
  430.                             Saizu(I) = 1
  431.                         NEXT I
  432.                     EXIT DO
  433.                 CASE CHR$(24), CHR$(27)
  434.                     Clear.Msg
  435.                     EXIT DO
  436.                 CASE ELSE
  437.                     bell 600, 32
  438.             END SELECT
  439.         LOOP
  440.         CY = 5
  441. END SUB
  442.  
  443. SUB Data.Load STATIC
  444.         OPEN Drive$ FOR APPEND AS #1
  445.         CLOSE #1
  446.         OPEN Drive$ FOR INPUT AS #1
  447.         rec = 0
  448.         WHILE NOT EOF(1)
  449.             rec = rec + 1
  450.             INPUT #1, Saizu.Data(rec)
  451.             INPUT #1, Bun.Data(rec)
  452.         WEND
  453.         CLOSE #1
  454. END SUB
  455.  
  456. SUB Data.Save
  457.         OPEN Drive$ FOR OUTPUT AS #1
  458.         FOR rec = 1 TO maxpage
  459.             WRITE #1, Saizu.Data(rec)
  460.             WRITE #1, Bun.Data(rec)
  461.         NEXT
  462.         CLOSE #1
  463. END SUB
  464.  
  465. SUB Data.Set
  466.         FOR I = 1 TO 12
  467.             Save.Data$ = Save.Data$ + LEFT$(In$(I) + SPACE$(36), 36)
  468.             Save.Saizu$ = Save.Saizu$ + RIGHT$("  " + MID$(STR$(Saizu(I)), 2), 1)
  469.         NEXT I
  470.             Saizu.Data(Page.No%) = Save.Saizu$
  471.             Bun.Data(Page.No%) = Save.Data$
  472. END SUB
  473.  
  474. SUB DATAX
  475.         Data.Save
  476.         gettext
  477.         box 22, 11, 59, 13, 3, 0
  478.  
  479.         COLOR 0, 3
  480.             LOCATE 11, 23: PRINT "データドライブ&データ名"
  481.             LOCATE 13, 23: PRINT CurDir$        ' カレントディレクトリィ
  482.         COLOR 7, 0
  483.             FOR I = 1 TO 4
  484.                 SONO$(I) = MID$(STR$(Sonota(I)), 2)
  485.             NEXT I
  486. DO
  487. In.Drive:
  488.         Ins% = OK
  489.         LOCATE 12, 23
  490.         IF MID$(Drive$, 2, 1) <> ":" THEN Drive$ = CurDir$ + Drive$
  491.         Drive$ = Line.Edit$(Drive$, 36, LastKey$, 0)
  492.         IF Drive$ <= SPACE$(36) OR LEN(Drive$) = LEN(CurDir$) THEN
  493.             bell 800, 32: bell 620, 40
  494.             box 22, 19, 59, 21, 14, 2
  495.             COLOR 7
  496.                 LOCATE 20, 28: PRINT "データ名を入力してください."
  497.                 GOTO In.Drive
  498.         END IF
  499.         IF MID$(Drive$, 2, 1) <> ":" THEN Drive$ = LEFT$(CurDir$ + Drive$ + SPACE$(36), 36)
  500.         Drive$ = UCASE$(Drive$)
  501.    
  502.     SELECT CASE LastKey$
  503.         CASE CHR$(13), CHR$(0, &H50), CHR$(&H18) ' リターンキー,DOWN
  504.             puttext
  505.             Save.DEF
  506.             Drive$ = RTRIM$(Drive$)
  507.             Disp.Name
  508.             Ins% = OK
  509.             EXIT SUB
  510.         CASE ELSE
  511.             EXIT DO
  512.     END SELECT
  513. LOOP
  514.         puttext
  515.         Ins% = OK
  516. END SUB
  517.  
  518. '------------
  519. '  一行削除
  520. '------------
  521. SUB DelLine
  522.         FOR I = N TO 11
  523.             In$(I) = In$(I + 1)
  524.             Saizu(I) = Saizu(I + 1)
  525.         NEXT I
  526.         scroll 0, 10, CY, 20, 16, 1
  527.         scroll 0, 23, CY, 58, 16, 1
  528.         In$(12) = SPACE$(36)
  529.         Saizu(12) = 1
  530.         LOCATE 16, 23: PRINT SPACE$(36);
  531.         LOCATE 16, 10: PRINT "○         "
  532. END SUB
  533.  
  534. SUB Disp.Func
  535.         LOCATE , , 0
  536.         textcolor 23
  537.         RESTORE PFDATA
  538.             FOR Row = 1 TO 10
  539.                 gotoxy Row * 7 - 6, 25
  540.                 READ tmp$: puts tmp$
  541.             NEXT
  542.         textcolor 7
  543. END SUB
  544.  
  545. SUB Disp.Help
  546.         gettext
  547.         box 1, 1, 80, 22, 6, 2
  548.         RESTORE HELPDATA
  549.             FOR Row = 1 TO 20
  550.                 gotoxy 3, Row + 1
  551.                 READ tmp$: puts tmp$
  552.             NEXT
  553.         A$ = In.Key$
  554.         puttext
  555. END SUB
  556.  
  557. SUB Disp.Name
  558.         textcolor 19: gotoxy 1, 1: puts SPACE$(34)
  559.         textcolor 23: gotoxy 1, 1: puts Drive$: textcolor 7
  560.         Ins% = OK: Page.No% = 1
  561.         ANS% = CheckFile%(Drive$)       ' DATAファイル CHECK
  562.         IF ANS% = 0 THEN New.Data
  563.         Data.Load
  564.         Disp.Page Page.No%
  565. END SUB
  566.  
  567. '------------------
  568. '  1ページデータ表示
  569. '------------------
  570. SUB Disp.Page (Page%)
  571.         LOCATE 4, 62, 0
  572.         PRINT USING "Page : &  &"; CDBL$(RIGHT$("  " + STR$(Page%), 2));
  573.  
  574.         P = 1
  575.         FOR N = 1 TO 12
  576.             In$(N) = MID$(Bun.Data(Page%), P, 36)
  577.             Saizu(N) = VAL(MID$(Saizu.Data(Page%), N, 1))
  578.             P = P + 36
  579.         NEXT N
  580.        
  581.         FOR N = 1 TO 12
  582.                 SELECT CASE Saizu(N)
  583.                     CASE 0, 1
  584.                         Set.KGM 1
  585.                     CASE 2
  586.                         Set.KGM 2
  587.                     CASE 3
  588.                         Set.KGM 3
  589.                     CASE 4
  590.                         Set.KGM 4
  591.                 END SELECT
  592.                 LOCATE N + 4, 23: PRINT In$(N)
  593.                 XPOS = LEN(RTRIM$(In$(N)))
  594.                 IF XPOS < 36 THEN
  595.                     LOCATE N + 4, 23 + XPOS
  596.                     textcolor 6
  597.                     putc (&H1F)
  598.                     textcolor 7
  599.                 END IF
  600.         NEXT N
  601. END SUB
  602.  
  603. DEFINT A-Z
  604. SUB Disp.TOKEI
  605.             gettext
  606.             box 3, 5, 77, 17, 3, 0
  607.             textcolor 19
  608.             gotoxy 53, 17: puts "何かキーを押すと戻ります"
  609.             textcolor 7
  610.  
  611.             DO
  612.                 textcolor 6
  613.                 FOR I = 1 TO 8
  614.                     MSG$ = MID$(TIME$, I, 1)
  615.                     SELECT CASE I
  616.                         CASE 1
  617.                             XPOS = 6
  618.                         CASE 2
  619.                             XPOS = 17
  620.                         CASE 3
  621.                             XPOS = 28
  622.                         CASE 4
  623.                             XPOS = 30
  624.                         CASE 5
  625.                             XPOS = 41
  626.                         CASE 6
  627.                             XPOS = 52
  628.                         CASE 7
  629.                             XPOS = 54
  630.                         CASE 8
  631.                             XPOS = 65
  632.                     END SELECT
  633.                    
  634.                     SELECT CASE MSG$
  635.                         CASE "0"
  636.                             gotoxy XPOS, 7:  puts "●●●●●"
  637.                             gotoxy XPOS, 8:  puts "●      ●"
  638.                             gotoxy XPOS, 9:  puts "●      ●"
  639.                             gotoxy XPOS, 10: puts "●      ●"
  640.                             gotoxy XPOS, 11: puts "●      ●"
  641.                             gotoxy XPOS, 12: puts "●      ●"
  642.                             gotoxy XPOS, 13: puts "●      ●"
  643.                             gotoxy XPOS, 14: puts "●      ●"
  644.                             gotoxy XPOS, 15: puts "●●●●●"
  645.                         CASE "1"
  646.                             gotoxy XPOS, 7:  puts "        ●"
  647.                             gotoxy XPOS, 8:  puts "        ●"
  648.                             gotoxy XPOS, 9:  puts "        ●"
  649.                             gotoxy XPOS, 10: puts "        ●"
  650.                             gotoxy XPOS, 11: puts "        ●"
  651.                             gotoxy XPOS, 12: puts "        ●"
  652.                             gotoxy XPOS, 13: puts "        ●"
  653.                             gotoxy XPOS, 14: puts "        ●"
  654.                             gotoxy XPOS, 15: puts "        ●"
  655.                         CASE "2"
  656.                             gotoxy XPOS, 7:  puts "●●●●●"
  657.                             gotoxy XPOS, 8:  puts "        ●"
  658.                             gotoxy XPOS, 9:  puts "        ●"
  659.                             gotoxy XPOS, 10: puts "        ●"
  660.                             gotoxy XPOS, 11: puts "●●●●●"
  661.                             gotoxy XPOS, 12: puts "●        "
  662.                             gotoxy XPOS, 13: puts "●        "
  663.                             gotoxy XPOS, 14: puts "●        "
  664.                             gotoxy XPOS, 15: puts "●●●●●"
  665.                         CASE "3"
  666.                             gotoxy XPOS, 7:  puts "●●●●●"
  667.                             gotoxy XPOS, 8:  puts "        ●"
  668.                             gotoxy XPOS, 9:  puts "        ●"
  669.                             gotoxy XPOS, 10: puts "        ●"
  670.                             gotoxy XPOS, 11: puts "●●●●●"
  671.                             gotoxy XPOS, 12: puts "        ●"
  672.                             gotoxy XPOS, 13: puts "        ●"
  673.                             gotoxy XPOS, 14: puts "        ●"
  674.                             gotoxy XPOS, 15: puts "●●●●●"
  675.                         CASE "4"
  676.                             gotoxy XPOS, 7:  puts "●      ●"
  677.                             gotoxy XPOS, 8:  puts "●      ●"
  678.                             gotoxy XPOS, 9:  puts "●      ●"
  679.                             gotoxy XPOS, 10: puts "●      ●"
  680.                             gotoxy XPOS, 11: puts "●●●●●"
  681.                             gotoxy XPOS, 12: puts "        ●"
  682.                             gotoxy XPOS, 13: puts "        ●"
  683.                             gotoxy XPOS, 14: puts "        ●"
  684.                             gotoxy XPOS, 15: puts "        ●"
  685.                         CASE "5"
  686.                             gotoxy XPOS, 7:  puts "●●●●●"
  687.                             gotoxy XPOS, 8:  puts "●        "
  688.                             gotoxy XPOS, 9:  puts "●        "
  689.                             gotoxy XPOS, 10: puts "●        "
  690.                             gotoxy XPOS, 11: puts "●●●●●"
  691.                             gotoxy XPOS, 12: puts "        ●"
  692.                             gotoxy XPOS, 13: puts "        ●"
  693.                             gotoxy XPOS, 14: puts "        ●"
  694.                             gotoxy XPOS, 15: puts "●●●●●"
  695.                         CASE "6"
  696.                             gotoxy XPOS, 7:  puts "●●●●●"
  697.                             gotoxy XPOS, 8:  puts "●        "
  698.                             gotoxy XPOS, 9:  puts "●        "
  699.                             gotoxy XPOS, 10: puts "●        "
  700.                             gotoxy XPOS, 11: puts "●●●●●"
  701.                             gotoxy XPOS, 12: puts "●      ●"
  702.                             gotoxy XPOS, 13: puts "●      ●"
  703.                             gotoxy XPOS, 14: puts "●      ●"
  704.                             gotoxy XPOS, 15: puts "●●●●●"
  705.                         CASE "7"
  706.                             gotoxy XPOS, 7:  puts "●●●●●"
  707.                             gotoxy XPOS, 8:  puts "        ●"
  708.                             gotoxy XPOS, 9:  puts "        ●"
  709.                             gotoxy XPOS, 10: puts "        ●"
  710.                             gotoxy XPOS, 11: puts "        ●"
  711.                             gotoxy XPOS, 12: puts "        ●"
  712.                             gotoxy XPOS, 13: puts "        ●"
  713.                             gotoxy XPOS, 14: puts "        ●"
  714.                             gotoxy XPOS, 15: puts "        ●"
  715.                         CASE "8"
  716.                             gotoxy XPOS, 7:  puts "●●●●●"
  717.                             gotoxy XPOS, 8:  puts "●      ●"
  718.                             gotoxy XPOS, 9:  puts "●      ●"
  719.                             gotoxy XPOS, 10: puts "●      ●"
  720.                             gotoxy XPOS, 11: puts "●●●●●"
  721.                             gotoxy XPOS, 12: puts "●      ●"
  722.                             gotoxy XPOS, 13: puts "●      ●"
  723.                             gotoxy XPOS, 14: puts "●      ●"
  724.                             gotoxy XPOS, 15: puts "●●●●●"
  725.                         CASE "9"
  726.                             gotoxy XPOS, 7:  puts "●●●●●"
  727.                             gotoxy XPOS, 8:  puts "●      ●"
  728.                             gotoxy XPOS, 9:  puts "●      ●"
  729.                             gotoxy XPOS, 10: puts "●      ●"
  730.                             gotoxy XPOS, 11: puts "●●●●●"
  731.                             gotoxy XPOS, 12: puts "        ●"
  732.                             gotoxy XPOS, 13: puts "        ●"
  733.                             gotoxy XPOS, 14: puts "        ●"
  734.                             gotoxy XPOS, 15: puts "●●●●●"
  735.                         CASE ":"
  736.                             gotoxy XPOS, 9:  putc (&HEA)
  737.                             gotoxy XPOS, 13: putc (&HEA)
  738.                     END SELECT
  739.                 NEXT
  740.                 A$ = INKEY$
  741.             LOOP WHILE A$ = ""
  742.             textcolor 7
  743.             puttext
  744. END SUB
  745.  
  746. DEFSNG A-Z
  747. SUB DownPage (Page%, Count%)
  748.         Data.Set
  749.         Page.No% = Page% - Count%
  750.         IF Page.No% < 1 THEN Page.No% = maxpage%
  751.         Disp.Page Page.No%
  752. END SUB
  753.  
  754. SUB ENDING
  755.         box 20, 6, 59, 12, 6, 2
  756.         gotoxy 26, 8: puts " 毎度ありがとうございました "
  757.         gotoxy 26, 10: puts "またの御来店お待ちしています"
  758.         LOCATE 20, 1: COLOR 7, 0
  759.         END
  760. END SUB
  761.  
  762. SUB Func.ON (PF.Number AS INTEGER)
  763.         RESTORE PFDATA
  764.             FOR Row = 1 TO PF.Number
  765.                 READ tmp$
  766.             NEXT
  767.         gotoxy PF.Number * 7 - 6, 25
  768.         textcolor 22: puts tmp$: textcolor 7
  769. END SUB
  770.  
  771. '------------
  772. '  画面描画
  773. '------------
  774. SUB Gamen
  775.         clrscr
  776.         CLS
  777.         textcolor 19
  778.         gotoxy 1, 1: puts SPACE$(80)
  779.         gotoxy 35, 1: puts "[   :   ]"
  780.         gotoxy 69, 1: puts "HOMEでヘルプ"
  781.         gotoxy 71, 2
  782.             TUKI$ = RIGHT$("  " + STR$(VAL(MID$(DATE$, 6, 2))), 2)
  783.             HI$ = RIGHT$("  " + STR$(VAL(MID$(DATE$, 9))), 2)
  784.         textcolor 6
  785.             puts MID$(DATE$, 3, 2) + CHR$(&H1B) + CHR$(&HF2)
  786.             puts TUKI$ + CHR$(&H1B) + CHR$(&HF3)
  787.             puts HI$ + CHR$(&H1B) + CHR$(&HF4)
  788.         textcolor 2
  789.             gotoxy 10, 3: puts "標 横 縦 4"
  790.         box 9, 4, 21, 17, 3, 2: box 22, 4, 59, 17, 9, 2
  791.         textcolor 9: gotoxy 43, 4: putc (&H91): gotoxy 43, 17: putc (&H90)
  792.         Disp.Func
  793.         Disp.Name
  794.         textcolor 7
  795. END SUB
  796.  
  797. '----------------
  798. '  みせじまい?
  799. '----------------
  800. SUB Heiten
  801.         bell 800, 32: bell 620, 40
  802.         box 22, 18, 59, 22, 15, 2
  803.  
  804.         COLOR 15: LOCATE 19, 31: PRINT "閉店してもよいですか?"
  805.         COLOR 7: LOCATE 21, 31: PRINT YN.MSG$
  806.                        
  807.         DO
  808.             A$ = In.Key$
  809.             SELECT CASE A$
  810.                 CASE CHR$(13)
  811.                     Data.Set
  812.                     Data.Save
  813.                     clrscr
  814.                     ENDING
  815.                 CASE CHR$(24), CHR$(27)
  816.                     Clear.Msg
  817.                     EXIT DO
  818.                 CASE ELSE
  819.                     bell 600, 32
  820.             END SELECT
  821.         LOOP
  822. END SUB
  823.  
  824. '------------
  825. '  一行挿入
  826. '------------
  827. SUB InsLine
  828.         FOR I = 12 TO N STEP -1
  829.             In$(I) = In$(I - 1)
  830.             Saizu(I) = Saizu(I - 1)
  831.         NEXT I
  832.         scroll 1, 10, CY, 20, 16, 1
  833.         scroll 1, 23, CY, 58, 16, 1
  834.         In$(N) = SPACE$(36)
  835.         Saizu(N) = 1
  836.         LOCATE CY, 23: PRINT SPACE$(36);
  837.         LOCATE CY, 10: PRINT "○         "
  838. END SUB
  839.  
  840. DEFINT A-Z
  841. '--------------------
  842. '  ラインエディター
  843. '--------------------
  844. FUNCTION Line.Edit$ (Arg$, Length%, LastKey$, strflag%)
  845.     X0% = POS(0)
  846.     Y0% = CSRLIN: IF X0% + Length% > 80 THEN ERROR 5
  847.     ChangeFlag% = OK
  848.  
  849.     COLOR 7, 0
  850.     dx% = 0
  851. '   Ins% = OK
  852.     tmp$ = LEFT$(Arg$ + SPACE$(Length%), Length%)
  853.     DO
  854. '        DO: LOOP WHILE INKEY$ <> ""   ' キーバッフアークリアー
  855.  
  856.         MaxCharNum% = KLEN(tmp$)
  857. '-------------------------------------
  858.         IF dx% >= Length% THEN dx% = Length% - 1 ELSE dx% = dx%
  859.         LOCATE 1, 41, 0
  860.         COLOR 0, 3
  861.             PRINT USING "##"; dx% + 1;
  862.         COLOR 7, 0
  863. '-------------------------------------
  864.         FOR I% = 1 TO MaxCharNum%
  865.             IF KPOS(tmp$, I%) <= Length% THEN MaxByte% = KPOS(tmp$, I%)
  866.         NEXT
  867.         IF dx% + 1 >= Length% THEN dx% = MaxByte% - 1
  868.         LastByte% = ASC(MID$(tmp$, MaxByte%, 1))
  869.         IF LastByte% >= &H80 AND (LastByte% < &HA0 OR LastByte% > &HDF) THEN
  870.               IF MaxByte% = Length% THEN
  871.                 tmp$ = LEFT$(tmp$, MaxByte% - 1) + " "
  872.             END IF
  873.         END IF
  874.  
  875. '       CharNum% = MaxCharNum% + 1   ' 一番右で削除キーを押すとエラーになる?
  876.         CharNum% = MaxCharNum%
  877.  
  878.         FOR I% = 1 TO MaxCharNum% - 1
  879.             IF KPOS(tmp$, I%) = dx% + 1 THEN CharNum% = I%
  880.         NEXT
  881. '------------------------------------------------------ a$=INKEY$ ココニアッタ
  882.         tmp$ = LEFT$(tmp$ + SPACE$(Length%), Length%)
  883.         IF ChangeFlag% = OK THEN
  884.             IF px% < dx% THEN
  885.                 LOCATE Y0%, X0% + px%, 0
  886.                 PRINT MID$(tmp$, px% + 1);
  887.             ELSE
  888.                 LOCATE Y0%, X0% + dx%, 0
  889.                 PRINT MID$(tmp$, dx% + 1);
  890.             END IF
  891.             ChangeFlag% = NG
  892. '-------------------------------------------------
  893.                 XPOS = LEN(RTRIM$(tmp$))
  894.                 IF XPOS < 36 AND strflag > -1 THEN
  895.                     LOCATE Y0%, X0% + XPOS
  896.                     textcolor 6
  897.                     putc (&H1F)
  898.                     textcolor 7
  899.                 END IF
  900. '-------------------------------------------------
  901.  
  902.         END IF
  903.         px% = dx%
  904.  
  905. '-------------------------------------------------
  906.         COLOR 0, 3
  907.         IF Ins% = NG THEN
  908.              LOCATE 1, 53: PRINT "[上書]"
  909.         ELSE LOCATE 1, 53: PRINT "<挿入>"
  910.         END IF
  911.         COLOR 7, 0
  912. '-------------------------------------------------
  913.         LOCATE Y0%, X0% + dx%, 1, -(Ins% = OK) * 13, 15
  914.  
  915.         A$ = In.Key$
  916.         Clear.Msg
  917.  
  918.         LastKey$ = A$
  919.         SELECT CASE A$
  920.  
  921.             CASE CHR$(0, &H4B), CHR$(&H13)  ' 左矢印
  922.                 dx% = dx% - 1
  923.                 IF dx% < 0 THEN
  924.                     dx% = 0
  925.                 ELSE
  926.                     IF SCREEN(Y0%, X0% + dx%) < 0 THEN dx% = dx% - 1
  927.                 END IF
  928.  
  929.             CASE CHR$(0, &H4D), CHR$(&H4)   ' 右矢印
  930.                 IF SCREEN(Y0%, X0% + dx%) > 255 THEN dx% = dx% + 1
  931.                     dx% = dx% + 1
  932.  
  933.             CASE CHR$(0, &H52)              ' 挿入
  934.                 Ins% = (Ins% = NG)
  935.  
  936.             CASE CHR$(0, &H53), CHR$(&H7)   ' 削除 or^G
  937.                 ChangeFlag% = OK
  938.                 tmp$ = KMID$(tmp$, 1, CharNum% - 1) + KMID$(tmp$, CharNum% + 1, LEN(tmp$) - CharNum%) + "  "
  939.  
  940.             CASE CHR$(8)                    'バックスペース
  941.                 ChangeFlag% = OK
  942.                 dx% = dx% - 1
  943.                 IF dx% < 0 THEN
  944.                     dx% = 0
  945.                 ELSE
  946.                     IF SCREEN(Y0%, X0% + dx%) < 0 THEN dx% = dx% - 1
  947.                 END IF
  948.  
  949.                 IF CharNum% >= 2 THEN tmp$ = KMID$(tmp$, 1, CharNum% - 2) + KMID$(tmp$, CharNum%, LEN(tmp$) - CharNum% + 1) + "  "
  950.                 IF CharNum% = 1 THEN tmp$ = KMID$(tmp$, 1, CharNum% - 1) + KMID$(tmp$, CharNum% + 1, LEN(tmp$) - CharNum%) + "  "
  951.  
  952.             CASE CHR$(0, &H87)             ' SHIFT+PF11
  953.                 dx% = 0
  954.  
  955. '           CASE CHR$(0, &H4F)             ' F14
  956.             CASE CHR$(0, &H88)             ' SHIFT+PF12
  957.                 dx% = LEN(RTRIM$(tmp$))
  958.             CASE CHR$(&HB)                 ' ^K  カーソル以降削除
  959.                     ChangeFlag% = OK
  960.                     tmp$ = LEFT$(tmp$, dx%)
  961.                     tmp$ = LEFT$(tmp$ + SPACE$(Length%), Length%)
  962.             CASE CHR$(&H15)                ' ^U  行頭からカーソル位置前まで削除
  963.                     ChangeFlag% = OK
  964.                     tmp$ = MID$(tmp$ + SPACE$(Length%), dx% + 1)
  965.                     dx% = 0
  966.  
  967.             CASE IS >= " "          '文字入力
  968.                 ChangeFlag% = OK
  969.                 'ひらがな, かたかなの半角化処理
  970.                 IF strflag% < 0 THEN
  971.                     A$ = CSNG$(A$)
  972.                 END IF
  973.                 IF strflag% > 0 THEN
  974.                     A$ = CDBL$(A$)
  975.                 END IF
  976.                 IF strflag% > 0 THEN A$ = CDBL$(A$)
  977.                 IF strflag% = 0 OR (strflag% < 0 AND ASC(A$) < 256) OR (strflag% > 0 AND ASC(A$) >= 256) THEN
  978.                     IF Ins% = NG THEN
  979.                         tmp$ = tmp$ + " "
  980.                         KMID$(tmp$, CharNum%, 1) = A$
  981.                         ELSE
  982.                         tmp$ = KMID$(tmp$, 1, CharNum% - 1) + A$ + KMID$(tmp$, CharNum%, LEN(tmp$) - CharNum% + 1)
  983.                     END IF
  984.                     IF ASC(A$) >= 256 THEN dx% = dx% + 1
  985.                     dx% = dx% + 1
  986.                 END IF
  987.             CASE ELSE
  988.                 EXIT DO      ' 以外は出す
  989.         END SELECT
  990.     LOOP
  991.     COLOR 7, 0
  992.     LOCATE Y0%, X0%, 0
  993.     PRINT tmp$;
  994.     Line.Edit$ = RTRIM$(tmp$)
  995.  
  996.     XPOS = LEN(RTRIM$(tmp$))
  997.     IF XPOS < 36 AND strflag > -1 THEN
  998.         LOCATE Y0%, X0% + XPOS
  999.         textcolor 6
  1000.         putc (&H1F)
  1001.         textcolor 7
  1002.     END IF
  1003.  
  1004. END FUNCTION
  1005.  
  1006. DEFSNG A-Z
  1007. SUB MENU
  1008.  
  1009. DIM SttLst$(1 TO 5)
  1010.  
  1011.     RESTORE SttMsgLst
  1012.     READ SttTtl$
  1013.     FOR I% = LBOUND(SttLst$) TO UBOUND(SttLst$)
  1014.         READ SttLst$(I%)
  1015.     NEXT
  1016.  
  1017. DO
  1018.     ANS% = BOXMENU%(26, 8, SttTtl$, SttLst$())
  1019.         SELECT CASE ANS%
  1020.             CASE 0
  1021.                 EXIT DO
  1022.             CASE 1
  1023.                 Heiten
  1024.                 EXIT DO
  1025.             CASE 2
  1026.                 Set.Data
  1027.                 EXIT DO
  1028.             CASE 3
  1029.                 DATAX
  1030.                 EXIT DO
  1031.             CASE 4
  1032.                 PageCopy
  1033.                 EXIT DO
  1034.             CASE 5
  1035.                 Disp.TOKEI
  1036.                 EXIT DO
  1037.         END SELECT
  1038. LOOP
  1039.  
  1040. END SUB
  1041.  
  1042. SUB New.Data
  1043.         FOR J = 1 TO maxpage
  1044.             FOR I = 1 TO 12
  1045.                 Save.Data$ = Save.Data$ + SPACE$(36)
  1046.                 Save.Saizu$ = Save.Saizu$ + "1"
  1047.             NEXT I
  1048.                 Saizu.Data(J) = Save.Saizu$
  1049.                 Bun.Data(J) = Save.Data$
  1050.         NEXT J
  1051.  
  1052.         OPEN Drive$ FOR OUTPUT AS #1
  1053.         FOR rec = 1 TO maxpage
  1054.             WRITE #1, Saizu.Data(rec)
  1055.             WRITE #1, Bun.Data(rec)
  1056.         NEXT
  1057.         CLOSE #1
  1058. END SUB
  1059.  
  1060. SUB NO.Data
  1061.         bell 800, 32: bell 620, 40
  1062.         box 22, 19, 59, 21, 11, 2
  1063.         COLOR 11
  1064.             LOCATE 20, 31, 0: PRINT "データが、ありません."
  1065.         COLOR 7
  1066. END SUB
  1067.  
  1068. SUB PageCopy
  1069.  
  1070.         Data.Save
  1071.         gettext
  1072.         box 23, 5, 58, 16, 3, 0
  1073.         gotoxy 35, 5: textcolor 19: puts "Page Copy": textcolor 7
  1074.         Ins% = NG
  1075. IN.1:
  1076.         gotoxy 29, 8: puts "コピー元の Page No. ?"
  1077.         LOCATE 8, 51
  1078.         Copy.Form$ = Line.Edit$(Copy.Form$, 2, LastKey$, -1)
  1079.         IF LastKey$ = CHR$(27) OR Copy.Form$ = "" THEN GOTO EX
  1080.         IF VAL(Copy.Form$) < 1 OR VAL(Copy.Form$) > 30 THEN bell 600, 32: GOTO IN.1
  1081. IN.2:
  1082.         gotoxy 29, 11: puts "コピー先の Page No. ?"
  1083.         LOCATE 11, 51
  1084.         Copy.To$ = Line.Edit$(Copy.To$, 2, LastKey$, -1)
  1085.         IF LastKey$ = CHR$(27) OR Copy.To$ = "" THEN GOTO EX
  1086.         IF VAL(Copy.To$) < 1 OR VAL(Copy.To$) > 30 THEN bell 600, 32: GOTO IN.2
  1087.         IF VAL(Copy.To$) = VAL(Copy.Form$) THEN bell 600, 32: GOTO IN.2
  1088.         gotoxy 31, 14: puts "○:実 行  ×:取 消"
  1089. DO
  1090.         A$ = In.Key$
  1091.         SELECT CASE A$
  1092.             CASE CHR$(13)
  1093.                 Saizu.Data(VAL(Copy.To$)) = Saizu.Data(VAL(Copy.Form$))
  1094.                 Bun.Data(VAL(Copy.To$)) = Bun.Data(VAL(Copy.Form$))
  1095.                 EXIT DO
  1096.             CASE CHR$(24), CHR$(27)
  1097.                 EXIT DO
  1098.             CASE ELSE
  1099.                 bell 600, 32
  1100.         END SELECT
  1101. LOOP
  1102. EX: 
  1103.         puttext
  1104.         Ins% = OK
  1105.         Disp.Page Page.No%
  1106. END SUB
  1107.  
  1108. '------------------
  1109. '  LABEL.DEF セーブ
  1110. '------------------
  1111. SUB Save.DEF
  1112.         OPEN CurDir$ + "LABEL.DEF" FOR RANDOM AS 2 LEN = 48
  1113.         FIELD #2, 36 AS Drive.Name$, 12 AS Sonota.Data$
  1114.         GET #2, 1
  1115.         DN$ = "": SD$ = ""
  1116.         FOR WD = 1 TO 4
  1117.             SD$ = SD$ + RIGHT$("   " + SONO$(WD), 3)
  1118.         NEXT WD
  1119.         LSET Drive.Name$ = LEFT$(Drive$ + SPACE$(36), 36)
  1120.         LSET Sonota.Data$ = SD$
  1121.         PUT #2, 1
  1122.         CLOSE #2
  1123. END SUB
  1124.  
  1125. '--------------------
  1126. '  ちょっとだけ設定
  1127. '--------------------
  1128. SUB Set.Data
  1129.  
  1130.         CCY = 6: CCX = 45
  1131.  
  1132.         Data.Save
  1133.         gettext
  1134.         box 16, 4, 65, 17, 6, 3
  1135.         box 22, 11, 59, 13, 3, 0
  1136.            
  1137.         COLOR 22
  1138.         LOCATE 4, 32:  PRINT " ちょっとだけ設定 "
  1139.         COLOR 3
  1140.         LOCATE 6, 23:  PRINT "印刷開始紙送り量(行)      行          3"
  1141.         LOCATE 7, 23:  PRINT "左マージン(1/180インチ)                  10"
  1142.         LOCATE 8, 23:  PRINT "改行ピッチ(1/180インチ)      1 から 60   30"
  1143.         LOCATE 9, 23: PRINT "印刷後改ページ有り?      0:無 1:有   0"
  1144.         COLOR 0, 3
  1145.         LOCATE 11, 23: PRINT "データドライブ&データ名"
  1146.         LOCATE 13, 23: PRINT CurDir$        ' カレントディレクトリィ
  1147.         COLOR 7, 0
  1148.         LOCATE 15, 31: PRINT "ESC: 中止   F1: Save"
  1149.           
  1150.         FOR I = 1 TO 4
  1151.             SONO$(I) = MID$(STR$(Sonota(I)), 2)
  1152.             LOCATE I + 5, 45: PRINT USING "& &"; SONO$(I)
  1153.         NEXT I
  1154.         LOCATE 12, 23: PRINT Drive$
  1155.          
  1156. '       Sonota(1) = 印刷開始紙送り量(行)
  1157. '       Sonota(2) = 左マージン(1/180インチ)
  1158. '       Sonota(3) = 改行ピッチ(1/180インチ)
  1159. '       Sonota(4) = 印刷後改ページ有り?
  1160.  
  1161. DO
  1162. F11START:
  1163.         LOCATE CCY, CCX
  1164.         Ins% = NG
  1165.         IF CCY = 12 THEN
  1166. Input.Drive:
  1167.         Ins% = OK
  1168.         LOCATE CCY, 23
  1169.         IF MID$(Drive$, 2, 1) <> ":" THEN Drive$ = CurDir$ + Drive$
  1170.         Drive$ = Line.Edit$(Drive$, 36, LastKey$, 0)
  1171.         IF Drive$ <= SPACE$(36) OR LEN(Drive$) = LEN(CurDir$) THEN
  1172.             bell 800, 32: bell 620, 40
  1173.             box 22, 19, 59, 21, 14, 2
  1174.             COLOR 7
  1175.                 LOCATE 20, 28: PRINT "データ名を入力してください."
  1176.                 GOTO Input.Drive
  1177.         END IF
  1178.         IF MID$(Drive$, 2, 1) <> ":" THEN Drive$ = LEFT$(CurDir$ + Drive$ + SPACE$(36), 36)
  1179.         Drive$ = UCASE$(Drive$): LOCATE CCY, 23: PRINT Drive$
  1180.        
  1181.         ELSE
  1182.         I = CCY - 5
  1183.         SONO$(I) = Line.Edit$(SONO$(I), 3, LastKey$, -1)
  1184.         Sonota(I) = VAL(SONO$(I))
  1185.         LOCATE CCY, 45: PRINT USING "& &"; SONO$(I)
  1186.                                    
  1187.         IF Sonota(3) = 0 OR Sonota(3) > 60 THEN bell 600, 32: Sonota(3) = 30: GOTO F11START
  1188.         IF Sonota(4) > 1 THEN bell 600, 32: Sonota(4) = 0: GOTO F11START
  1189.         END IF
  1190.        
  1191.     SELECT CASE LastKey$
  1192.         CASE CHR$(13), CHR$(0, &H50), CHR$(&H18) ' リターンキー ,↓ DOWN
  1193.             SELECT CASE CCY
  1194.                 CASE 12
  1195.                     CCY = 6
  1196.                 CASE 9
  1197.                     CCY = 12
  1198.                 CASE ELSE
  1199.                     CCY = CCY + 1
  1200.             END SELECT
  1201.         CASE CHR$(0, &H3B)             ' PF1
  1202.             puttext
  1203.             Save.DEF
  1204.             Drive$ = RTRIM$(Drive$)
  1205.             Disp.Name
  1206.             Ins% = OK
  1207.             EXIT SUB
  1208.         CASE CHR$(&H1B)                ' ESC
  1209.             EXIT DO
  1210.         CASE CHR$(0, &H48), CHR$(&H5)  ' ↑ UP
  1211.             SELECT CASE CCY
  1212.                 CASE 6
  1213.                     CCY = 12
  1214.                 CASE 12
  1215.                     CCY = 9
  1216.                 CASE ELSE
  1217.                     CCY = CCY - 1
  1218.             END SELECT
  1219.     END SELECT
  1220. LOOP
  1221.         puttext
  1222.         Ins% = OK
  1223. END SUB
  1224.  
  1225. '------------------
  1226. '  文字サイズ設定
  1227. '------------------
  1228. SUB Set.KGM (SetNO AS INTEGER)
  1229.  
  1230.     SELECT CASE SetNO
  1231.         CASE 0, 1
  1232.             Print.Data$ = "○         "
  1233.         CASE 2
  1234.             IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
  1235.             Print.Data$ = "   ○      "
  1236.         CASE 3
  1237.             IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
  1238.             IF N = 12 THEN Boo: EXIT SUB
  1239.             IF In$(N + 1) <= SPACE$(36) THEN  ELSE Boo: EXIT SUB
  1240.             Print.Data$ = "      ○   "
  1241.         CASE 4
  1242.             IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
  1243.             IF N = 12 THEN Boo: EXIT SUB
  1244.             IF In$(N + 1) <= SPACE$(36) THEN  ELSE Boo: EXIT SUB
  1245.             Print.Data$ = "         ○"
  1246.     END SELECT
  1247.             Saizu(N) = SetNO
  1248.             LOCATE N + 4, 10: PRINT Print.Data$
  1249. END SUB
  1250.  
  1251. SUB UpPage (Page%, Count%)
  1252.         Data.Set
  1253.         Page.No% = Page% + Count%
  1254.         IF Page.No% > maxpage% THEN Page.No% = 1
  1255.         Disp.Page Page.No%
  1256. END SUB
  1257.  
  1258. '--------------------
  1259. '  左寄・中央・右寄
  1260. '--------------------
  1261. SUB Write.LCR (FG AS INTEGER)
  1262.  
  1263.         IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
  1264.  
  1265.         In$(N) = LTRIM$(In$(N))             ' 先頭空白文字の除去 (ひだりよせ)
  1266.  
  1267.         SELECT CASE FG
  1268.             CASE 2                          ' センタリング
  1269.                 Dmy$ = LEFT$(In$(N), 2)
  1270.                 SNSP = LEN(In$(N))
  1271. '               IF ASC(Dmy$) <= 255 THEN    ' ANK
  1272.                     SSP = (36 - SNSP) \ 2
  1273.                     In$(N) = LEFT$((SPACE$(SSP) + In$(N)), 36)
  1274. '               ELSE                        ' 漢字
  1275. '                   SSP = (18 - SNSP) \ 2
  1276. '                   In$(N) = LEFT$((STRING$(SSP, " ") + In$(N)), 36)
  1277. '                                               ' 全角スペース
  1278. '               END IF
  1279.             CASE 3                          ' みぎよせ
  1280.                 Dmy$ = LEFT$(In$(N), 2)
  1281.                 MNSP = LEN(In$(N))
  1282. '               IF ASC(Dmy$) <= 255 THEN    ' ANK
  1283.                     MSP = 36 - MNSP
  1284.                     In$(N) = MID$((SPACE$(MSP) + In$(N)), 1, 36)
  1285. '               ELSE                        ' 漢字
  1286. '                   MSP = 18 - MNSP
  1287. '                   In$(N) = MID$((STRING$(MSP, " ") + In$(N)), 1, 36)
  1288. '                                              ' 全角スペース
  1289. '               END IF
  1290.         END SELECT
  1291.         LOCATE CY, 23: PRINT SPACE$(36);
  1292.         LOCATE CY, 23: PRINT In$(N);
  1293. END SUB
  1294.  
  1295.